System Booster/System Booster.iso/Texteditors/Origami/bindings/fun/fillpara

Text File | 1996-09-27 | 17.4 KB | 651 lines

@if-using not(ocl-file-fillpara)
  @use (ocl-file-fillpara)
  ;OCL{{{}}}
  ;OCL{{{  reference decription
  @if-using ( FUN-REFERENCE ) ; 1 ;
  This library offers the possibility, for automatic line break and block
  reformating of text files.
  @fi
  ;OCL}}}
  ;OCL{{{  libs
  @if-using not(ocl-file-delspaces) @lib delspaces @fi
  @use ( language-ocl )
  @if-using not(ocl-file-userlang)  @lib userlang @fi
  ;OCL}}}
  ;OCL{{{  variables
  ( defvar
     ( fill-x              ; help variable
       fill-count          ; help-counter
       fill-block          ; 1 -> block fillling, 0 -> shrink filling
       fill-col            ; last character in filled block
       wrap-mode           ; should spaces break line in macro wrap-word
       fill-begin          ; first char in block
       fill-start          ; start of lines
       fill-end            ; last char in block
       fill-width          ; # of chars in block
       fill-para-space-po  ; local var: position to start filling block-spaces
       fill-post-c         ; local var: missing spaces for block-fill
       fill-post-x         ; local var: space for block-fill found?
     )
  )
  ;OCL}}}
  ;OCL{{{  local functions
  ;OCL{{{  init-fill-column
  (deffun init-fill-column (if =(fill-col 0) (set fill-col 72) fi ) )
  ;OCL}}}
  ;OCL{{{  prompt-for-fill-column
  ( deffun prompt-for-fill-column
     ( begin-prompt-macro
       prompt-counter fill-x ( "fill-column "  "? "   )
       end-prompt-macro
       if >(fill-x 0)
        ( set fill-col fill-x )
       fi
     )
  )
  ;OCL}}}
  ;OCL}}}
  ;OCL{{{  fill-paragraph
  ;OCL{{{  reference
  @if-using ( FUN-REFERENCE ) ; 2 ; fill-para-called
  ;OCL{{{  fill-paragraph
  Fill all lines from cursor position to a end-of-block line.

  @ref-start-item end-of-block:
  @ref-start-item *
  A line using nother indentation
  @ref-end-item
  @ref-start-item *
  A line startting with the current begin-fold-comment string
  @ref-end-item
  @ref-start-item *
  If fill mode shrink and language Roff are active, a line starting with `.'.
  @ref-end-item
  @ref-start-item *
  If fill mode shrink and language Tex are active, a line starting with `\'.
  @ref-start-item *
  @ref-end-item
  If language OCL (User:`;OCL',`') is active, a line starting with `@'.
  @ref-end-item
  @ref-end-item

  If fill mode block is active, all but the last line are filled with spaces,
  to match the right margin exactly. Tabs inside the filled region will be
  replaced by spaces.
  ;OCL}}}
  @fi
  ;OCL}}}
  ;OCL{{{  fill-block
  ;OCL{{{  fill-line-start
  ( defvar ( nfls-x ) )
  ( deffun fill-line-start
     ( goto-counter fill-begin
       if or
           (
             ;OCL{{{  not text
             not(test-text)
             ;OCL}}}
             ;OCL{{{  incorrect line start
             not(test-begin-line)
             test-char "  ;
             test-char C-I
             ;OCL}}}
             ;OCL{{{  special line
             and
              ( not(fill-block)
                or
                 ( and(test-language TeX  test-char "\ )
                   and(test-language Roff test-char ". )
                 )
              )
             and(eval ( test-language-ocl ) test-char "@ )
             ;OCL}}}
             ;OCL{{{  starting with fold comment
             and
              ( fold-comment-start-length
                pre
                 ( set nfls-x 0
                   while
                      and
                       ( <(nfls-x fold-comment-start-length)
                         test-char fold-comment-start nfls-x
                       )
                    ( set nfls-x +(nfls-x 1) )
                   beginning-of-line
                 )
                   =(nfls-x fold-comment-start-length)
              )
             ;OCL}}}
           )
        ( return-value-from-macro false )
       fi
       return-value-from-macro true
     )
  )
  ( undeclare ( nfls-x ) )
  ;OCL}}}
  ;OCL{{{  show-line
  ( deffun show-line ( goto-counter fill-begin refresh-line ) )
  ;OCL}}}
  ;OCL{{{  pre-handle-line
  ( deffun pre-handle-line
     ( screen-off
       beginning-of-line
       while not(test-end-line)
        ( case
           ;OCL{{{  . -> maybe add space
           ( and
              ( not(fill-block)
                @if-using not(FORCE-DOT-SPACES)
                   test-language Roff
                @fi
                test-char ".
              )
             ( forward-character
               if or(test-char "  test-char C-I)
                ( "   ;
                  forward-character
                  delspaces
                )
               fi
             )
           )
           ;OCL}}}
           ;OCL{{{  space/tab: leave only one
           ( or(test-char "  test-char C-I)
             ( "  ;
               delspaces
             )
           )
           ;OCL}}}
          default
           ( forward-character )
          esac
        )
       screen-on
     )
  )
  ;OCL}}}
  ;OCL{{{  post-handle-line
  ( deffun post-handle-line
     ( if fill-block
        ;OCL{{{  expand sline exact to fill column
        ( screen-off
          ;OCL{{{  fill-post-c = number of missing spaces
          goto-counter fill-end
          set fill-post-c 0
          while and(not(test-begin-line),test-char " ) (
            set fill-post-c +(fill-post-c 1)
            backward-character
          )
          ;OCL}}}
          do
           ;OCL{{{  one line pass, fill-post-x=0, if space found
           (
             ;OCL{{{  move cursor to correct position
             if =(fill-para-space-po 0)
              ( set fill-post-x 1
                end-of-line
              )
             else
              ( set fill-post-x 0
                goto-counter fill-para-space-po
                while test-end-line (backward-character)
                forward-character
              )
             fi
             ;OCL}}}
             while and(>(fill-post-c 0) not(test-begin-line)) (
               ;OCL{{{  maybe insert space, go left
               backward-character
               if test-char "  (
                 "  ;
                 backward-character
                 backward-character
                 set fill-post-x 0
                 set fill-post-c +(fill-post-c -1)
               ) fi
               ;OCL}}}
             )
             set fill-para-space-po 0
           )
           ;OCL}}}
          while and(>(fill-post-c 0) =(fill-post-x 0))
          set fill-para-space-po store-pos
          screen-on
        )
        ;OCL}}}
       fi
       show-line
     )
  )
  ;OCL}}}
  ;OCL{{{  post-last-handle
  ( defmac post-last-handle
     ( if fill-block
        ( pre-handle-line show-line )
       fi
     )
  )
  ;OCL}}}
  ;OCL{{{  fill-line
  ( defmac fill-line
     (
       ;OCL{{{  how many chars needed, which position in next line
       screen-off
       end-of-line
       set fill-count store-pos
       backward-character
       if and
           ( not(fill-block)
             @if-using ( FORCE-DOT-SPACES )
                test-language Roff test-char ".
             @fi
           )
        ( set fill-count +(fill-count 1) )
       fi
       set fill-count -(fill-end fill-count)
       set fill-x +(fill-count fill-begin)
       screen-on
       ;OCL}}}
       next-line
       screen-off
       goto-counter fill-x
       if test-end-line
        ;OCL{{{  next line to short
        ( goto-counter fill-start
          delspaces
          screen-on
          delete-previous-character
          screen-off
          if and
              ( not(fill-block)
                @if-using ( FORCE-DOT-SPACES )
                   test-language Roff
                @fi
              )
           ( backward-character
             if test-char ". (forward-character " ) else (forward-character) fi
           )
          fi
          "  ;
          screen-on
        )
        ;OCL}}}
       else
        ;OCL{{{  line long
        (
          ;OCL{{{  search splitt positions
          while and(>(fill-count 0) not(test-char " ))
           ( backward-character
             set fill-count +(fill-count -1)
           )
          ;OCL}}}
          screen-on
          if >(fill-count 0)
           ;OCL{{{  can splitt
           ( newline-and-indent
             screen-off
             goto-counter fill-begin
             delspaces
             screen-on
             previous-line
             screen-off
             goto-counter fill-start
             delspaces
             screen-on
             delete-previous-character
             screen-off
             if and
                 ( not(fill-block)
                   @if-using ( FORCE-DOT-SPACES )
                      test-language Roff
                   @fi
                 )
              ( backward-character
                if test-char ".
                 ( forward-character "  )
                else
                 ( forward-character )
                fi
              )
             fi
             "  ;
             screen-on
             next-line
           )
           ;OCL}}}
          fi
          previous-line
          post-handle-line
          next-line
        )
        ;OCL}}}
       fi
     )
  )
  ;OCL}}}
  ;OCL{{{  splitt-line
  ( defmac splitt-line
     ( screen-off
       goto-counter fill-end
       forward-character
       set fill-count fill-width
       ;OCL{{{  look for a splitt-position
       while and(>(fill-count 0) not(test-char " ) not(test-char C-I))
        ( backward-character
          set fill-count +(fill-count -1)
        )
       screen-on
       if =(fill-count 0)
        ( return-from-macro )
       fi
       ;OCL}}}
       newline-and-indent
       screen-off
       goto-counter fill-begin
       delspaces
       screen-on
     )
  )
  ;OCL}}}
  ;OCL{{{  fill-loop
  ( defmac fill-loop
     ( while eval ( fill-line-start )
        ( goto-counter fill-end
          forward-character
          if test-end-line
           ;OCL{{{  fill or leave
           ( backward-character
             if test-end-line
              ;OCL{{{  fill it
              ( next-line
                if not( eval ( fill-line-start ) )
                 ;OCL{{{  => ready
                 ( previous-line
                   post-handle-line
                   show-line
                   next-line
                   beginning-of-line
                   return-from-macro
                 )
                 ;OCL}}}
                fi
                pre-handle-line
                previous-line
                fill-line
              )
              ;OCL}}}
             else
              ;OCL{{{  line exact ok
              ( post-handle-line
                next-line
                pre-handle-line
              )
              ;OCL}}}
             fi
           )
           ;OCL}}}
          else
           ;OCL{{{  splitting
           ( splitt-line
             previous-line
             post-handle-line
             next-line
           )
           ;OCL}}}
          fi
        )
       show-line
     )
  )
  ;OCL}}}

  ( defmac do-fill-paragraph
     (
       ;OCL{{{  set start/begin/end/fillpo/width
       ; fill-begin = first char in block
       ; fill-start = first edit-position in current fold
       ; fill-end   = fill-column
       ; fill-width = number of chars in a blockline
       ; fill-para-space-po = 0
       ;              counter to spread added spaces (block-mode)
       beginning-of-line
       set fill-begin store-pos
       newline-and-indent
       previous-line
       beginning-of-line
       set fill-start store-pos
       delete-line
       init-fill-column
       set fill-end fill-col
       set fill-width +(1 -(fill-end fill-begin))
       set fill-para-space-po 0
       ;OCL}}}
       ;OCL{{{  check start line
       if not(eval ( fill-line-start ))
        ( message ( M_ERR_PO )
          return-from-macro
        )
       fi
       ;OCL}}}
       pre-handle-line
       fill-loop
       previous-line
       post-last-handle
     )
  )
  ;OCL}}}

  ( deffun fill-paragraph
     ( case
        ( in-prompt () )
        ( test-overwrite ( message ( "Overwrite "! ) ) )
        ( not(test-text) ( message ( M_ERR_PO ) ) )
       default
        ( init-fill-column
          do-fill-paragraph
        )
       esac
     )
  )
  ;OCL}}}
  ;OCL{{{  set-fill-column
  ;OCL{{{  reference
  @if-using ( FUN-REFERENCE ) ; 2 ; set-col-called
  ;OCL{{{  set-fill-column
  Define the right margin for fill-paragraph. The value is given by:

  @ref-start-item
  modify-behaviour, if greater then 0,
  @ref-end-item
  @ref-start-item or
  by the value of repeat-argument,
  @ref-end-item
  @ref-start-item or
  the cursor x position, if greater than 20,
  @ref-end-item
  @ref-start-item or
  by your input (set-fill-column prompts for).
  @ref-end-item
  ;OCL}}}
  @fi
  ;OCL}}}
  (deffun set-fill-column
    ( init-fill-column
      set fill-x read-repeat
      case
       ( >(modify-behaviour 0) ( set fill-col modify-behaviour ) )
       ( >(fill-x 0)     ( set fill-col fill-x ) )
       ( >(store-pos 20) ( set fill-col store-pos ) )
      default
       ( prompt-for-fill-column )
      esac
    )
  )
  ;OCL}}}
  ;OCL{{{  set-fill-mode
  ;OCL{{{  reference
  @if-using ( FUN-REFERENCE ) ; 2 ; set-mode-called
  ;OCL{{{  set-fill-column
  Offers a menu, for selecting the fill mode (shrink or block) and the right
  fill margin.
  ;OCL}}}
  @fi
  ;OCL}}}
  ( deffun set-fill-mode
     ( set fill-x fill-block
       init-fill-column
       begin-prompt-macro
       menu-counter
          fill-x
        ( "Shrink "  "Block "  "Column "( counter fill-col ") )
       end-prompt-macro
       if =(fill-x 2)
        ( prompt-for-fill-column )
       else
        ( set fill-block fill-x )
       fi
     )
  )
  ;OCL}}}
  ;OCL{{{  wrap
  ( demand-load not
     (
        ;OCL{{{  wrap-word
        ;OCL{{{  reference
        @if-using ( FUN-REFERENCE ) ; 2 ; wrap-called
        ;OCL{{{  wrap-word
        Can be used to replace the single space.

        If used at end of a line, behind the right fill margin, the last word
        will be moved to the next line and a space will be added.

        In front of fill margin and if mode wrap is not active, a single space
        will be added.
        ;OCL}}}
        @fi
        ;OCL}}}
        ( deffun wrap-word
           ( if
              ;OCL{{{  word should be wrapped
                and
                 ( >(wrap-mode 0)
                   not(in-prompt)
                   test-end-line
                   pre ( init-fill-column ) >(store-pos fill-col)
                 )
              ;OCL}}}
              ;OCL{{{  wrap the word
              (
                ;OCL{{{  go to last char in line
                while and(test-char "  not(test-begin-line))
                 ( backward-character )
                ;OCL}}}
                ;OCL{{{  move to correct wrap-position
                if >(store-pos fill-col)
                 ;OCL{{{  wrap word
                 (
                   ;OCL{{{  move to last space
                   while and(not(test-char " ) not(test-begin-line))
                    ( backward-character )
                   ;OCL}}}
                   ;OCL{{{  if not at start-of-line, right to correct wrap-word
                   if test-begin-line ( end-of-line ) else ( forward-character ) fi
                   ;OCL}}}
                 )
                 ;OCL}}}
                else
                 ( forward-character )
                fi
                ;OCL}}}
                newline-and-indent
                ;OCL{{{  maybe move behind wraped word
                previous-line
                beginning-of-line
                next-line
                if not(test-end-line)
                 ( end-of-line "  )
                fi
                ;OCL}}}
              )
              ;OCL}}}
             else
              ;OCL{{{  insert space
              ( "  )
              ;OCL}}}
             fi
           )
        )
        ;OCL}}}
        ;OCL{{{  add/delete wrap-mode
        (defmodestring WM "Wrap "W )
        ;OCL{{{  add-mode-wrap
        ;OCL{{{  reference
        @if-using ( FUN-REFERENCE ) ; 2 ; add-wrap-called
        ;OCL{{{  add-mode-wrap
        Activate automatic line wrapping. Mark the mode with `Wrap' or `W' in
        the statusline.
        ;OCL}}}
        @fi
        ;OCL}}}
        (deffun add-mode-wrap (
          if in-prompt ( return-from-macro ) fi
          set wrap-mode 1 set-user-mode WM
        ))
        ;OCL}}}
        ;OCL{{{  delete-mode-wrap
        ;OCL{{{  reference
        @if-using ( FUN-REFERENCE ) ; 2 ; delete-wrap-called
        ;OCL{{{  delete-mode-wrap
        Switch of automatic line wrapping.
        ;OCL}}}
        @fi
        ;OCL}}}
        (deffun delete-mode-wrap (
          if in-prompt ( return-from-macro ) fi
          set wrap-mode 0 reset-user-mode WM
        ))
        ;OCL}}}
        ;OCL}}}
     )
  )
  ;OCL}}}
  ;OCL{{{  undeclare local data
  ( undeclare
     ( fill-block
       fill-col
       prompt-for-fill-column
       show-line
       pre-handle-line
       post-handle-line
       post-last-handle
       fill-line
       splitt-line
       fill-loop
       do-fill-paragraph
       fill-line-start
       fill-begin
       fill-start
       fill-end
       fill-width
       fill-para-space-po
       fill-post-c
       fill-post-x
       fill-count
       fill-x
     )
  )
  ;OCL}}}
  ;OCL{{{  reference hooks
  @if-using ( FUN-REFERENCE ) ; 3 ;
  The library uses begin-prompt-macro and end-prompt-macro.

  Defining the Tag FORCE-DOT-SPACES will always use 2 spaces after `.',
  if block filling is not active.

  The wrap-word macros are delared as demand-loading.
  @fi
  ;OCL}}}
@fi